home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / tests / signal.test < prev    next >
Encoding:
Text File  |  1993-10-26  |  7.4 KB  |  282 lines  |  [TEXT/MPS ]
  1. #
  2. # signal.test
  3. #
  4. # Tests for the signal and kill commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: signal.test,v 2.5 1993/07/20 08:35:45 markd Exp $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. #
  22. # Determine if we have Posix signals.
  23. #
  24. set msg {}
  25. set posix 1
  26. catch {signal unblock SIGHUP} msg
  27. if {$msg == "Posix signals are not available on this system"} {
  28.     set posix 0
  29. }
  30.  
  31. Test signal-1.1 {signal tests} {
  32.     signal ignore SIGHUP
  33.     kill HUP [id process]
  34. } 0 {}
  35.  
  36. Test signal-1.2 {signal tests} {
  37.     global errorInfo
  38.     set errorInfo {}
  39.     signal error HUP
  40.     proc KillMe3 {} {kill SIGHUP [id process]}
  41.     proc KillMe2 {} {KillMe3}
  42.     proc KillMe1 {} {KillMe2}
  43.     list [catch {KillMe1} msg] $msg $errorInfo
  44. } 0 {1 {SIGHUP signal received} {SIGHUP signal received
  45.     while executing
  46. "kill SIGHUP [id process]"
  47.     (procedure "KillMe3" line 1)
  48.     invoked from within
  49. "KillMe3"
  50.     (procedure "KillMe2" line 1)
  51.     invoked from within
  52. "KillMe2"
  53.     (procedure "KillMe1" line 1)
  54.     invoked from within
  55. "KillMe1"}}
  56.  
  57. Test signal-1.3 {signal tests} {
  58.     signal error {HUP SIGTERM}
  59.     set one [list [catch {kill HUP  [id process]} msg] $msg]
  60.     set two [list [catch {kill TERM [id process]} msg] $msg]
  61.     list $one $two
  62. } 0 {{1 {SIGHUP signal received}} {1 {SIGTERM signal received}}}
  63.  
  64. Test signal-1.4 {signal tests} {
  65.     set signalWeGot {}
  66.     signal trap 1 {set signalWeGot %S}
  67.     kill SIGHUP [id process]
  68.     signal default 1
  69.     set signalWeGot
  70. } 0 {SIGHUP}
  71.  
  72. Test signal-1.41 {signal tests} {
  73.     set signalWeGot {}
  74.     set signalTrash {}
  75.     signal trap 1 {set signalWeGot %S; set signalTrash "%%"}
  76.     kill SIGHUP [id process]
  77.     signal default 1
  78.     list $signalWeGot $signalTrash
  79. } 0 {SIGHUP %%}
  80.  
  81. Test signal-1.42 {signal tests} {
  82.     signal trap 1 {set signalWeGot %s; set signalTrash "%%"}
  83.     kill SIGHUP [id process]
  84. } 1 {bad signal trap command formatting specification "%s", expected one of "%%" or "%S"}
  85. signal default SIGHUP
  86.  
  87. Test signal-1.5 {signal tests} {
  88.     signal default {SIGHUP SIGINT}
  89.     signal get {SIGHUP SIGINT}
  90. } 0 {{SIGHUP {default 0}} {SIGINT {default 0}}}
  91.  
  92. Test signal-1.6 {signal tests} {
  93.     signal default SIGHUP
  94.     signal ignore  SIGINT
  95.     signal get {SIGHUP SIGINT}
  96. } 0 {{SIGHUP {default 0}} {SIGINT {ignore 0}}}
  97.  
  98. Test signal-1.7 {signal tests} {
  99.     signal trap {SIGHUP SIGINT} {error "Should not get this signal"}
  100.     signal get {SIGHUP SIGINT}
  101. } 0 [list {SIGHUP {trap 0 {error "Should not get this signal"}}} \
  102.           {SIGINT {trap 0 {error "Should not get this signal"}}} ]
  103.  
  104. Test signal-1.8 {signal tests} {
  105.     signal error {SIGHUP SIGINT}
  106.     signal get {SIGHUP SIGINT}
  107. } 0 {{SIGHUP {error 0}} {SIGINT {error 0}}}
  108.  
  109. Test signal-1.9 {signal tests} {
  110.     global errorInfo
  111.     set errorInfo {}
  112.     proc KillMe3 {} {kill SIGHUP [id process]}
  113.     proc KillMe2 {} {KillMe3}
  114.     proc KillMe1 {} {KillMe2}
  115.     signal trap SIGHUP {error "Blew it in the trap code"}
  116.     list [catch {KillMe1} msg ] $msg $errorInfo
  117. } 0 {1 {Blew it in the trap code} {Blew it in the trap code
  118.     while executing
  119. "error "Blew it in the trap code""
  120.     while executing signal trap code for SIGHUP signal
  121.     invoked from within
  122. "kill SIGHUP [id process]"
  123.     (procedure "KillMe3" line 1)
  124.     invoked from within
  125. "KillMe3"
  126.     (procedure "KillMe2" line 1)
  127.     invoked from within
  128. "KillMe2"
  129.     (procedure "KillMe1" line 1)
  130.     invoked from within
  131. "KillMe1"}}
  132.  
  133. Test signal-1.10 {signal tests} {
  134.     signal
  135. } 1 {wrong # args: signal action signalList ?command?}
  136.  
  137. Test signal-1.11 {signal tests} {
  138.     signal ignore foo
  139. } 1 {invalid signal name: foo}
  140.  
  141. Test signal-1.12 {signal tests} {
  142.     signal ignore sigint "echo foo"
  143. } 1 {command may not be specified for "ignore" action}
  144.  
  145. Test signal-1.13 {signal tests} {
  146.     signal baz sigint
  147. } 1 {invalid signal action specified: baz: expected one of "default", "ignore", "error", "trap", or "get", "block", "unblock"}
  148.  
  149. #
  150. # Complex test for the death of a child.
  151. #
  152.  
  153. proc PollSigChld {} {
  154.     global G_gotChild
  155.     set sleepCnt 0
  156.     while {!$G_gotChild} {
  157.         incr sleepCnt
  158.         if {$sleepCnt > 90} {
  159.             error "signal-1.14: SIGCHLD lost"
  160.         }
  161.         sleep 1
  162.     }
  163. }
  164.  
  165.  
  166. proc ForkChild {exitCode} {
  167.     flush stdout  ;# Not going to exec, must clean up the buffers.
  168.     flush stderr
  169.     set childPid [fork]
  170.     if {$childPid == 0} {
  171.         exit $exitCode
  172.     }
  173.     return $childPid
  174. }
  175.  
  176. if $posix {
  177.     set expect {123 {{SIGCHLD {trap 0 {global G_gotChild;set G_gotChild 1;sleep 1}}}}}
  178. } else {
  179.     set expect {123 {{SIGCHLD {default 0}}}}
  180. }
  181. set expect 
  182. Test signal-1.15 {signal tests} {
  183.     global G_gotChild
  184.     set G_gotChild 0
  185.     signal trap SIGCHLD {global G_gotChild;set G_gotChild 1;sleep 1}
  186.     set pid1 [ForkChild 123] 
  187.     PollSigChld
  188.     set status1 [wait $pid1]
  189.     list [lindex $status1 2] [signal get SIGCHLD]
  190. } 0 $expect
  191.  
  192. signal default SIGCHLD
  193.  
  194. #
  195. # Check that the signals are left in the correct state after receiving
  196. # a signal (on SIGCHLD is different if we have Posix signals).
  197. #
  198.  
  199. Test signal-1.16 {signal tests} {
  200.     global G_gotChild
  201.     set G_gotChild 0
  202.     signal trap SIGCHLD {global G_gotChild;set G_gotChild 1}
  203.     kill SIGCHLD [id process]
  204.     set gotChild1 $G_gotChild
  205.     set G_gotChild 0
  206.     kill SIGCHLD [id process]
  207.     set gotChild2 $G_gotChild
  208.     set G_gotChild 0
  209.     signal trap SIGCHLD {global G_gotChild;set G_gotChild 1}
  210.     kill SIGCHLD [id process]
  211.     set gotChild3 $G_gotChild
  212.     signal default SIGCHLD
  213.     list $gotChild1 $gotChild2 $gotChild3
  214. } 0 [list 1 $posix 1]
  215.  
  216.  
  217. Test signal-1.17 {signal tests} {
  218.     global G_gotPipe
  219.     set G_gotPipe 0
  220.     signal trap SIGPIPE {global G_gotPipe;set G_gotPipe 1}
  221.     kill SIGPIPE [id process]
  222.     set gotPipe1 $G_gotPipe
  223.     set G_gotPipe 0
  224.     kill SIGPIPE [id process]
  225.     set gotPipe2 $G_gotPipe
  226.     signal default SIGPIPE
  227.     list $gotPipe1 $gotPipe2
  228. } 0 {1 1}
  229.  
  230. if $posix {
  231.     Test signal-1.18 {signal tests} {
  232.         signal error SIGHUP
  233.         signal block SIGHUP
  234.         signal get SIGHUP
  235.     } 0 {{SIGHUP {error 1}}}
  236.  
  237.     Test signal-1.19 {signal tests} {
  238.         signal unblock SIGHUP
  239.         signal get SIGHUP
  240.     } 0 {{SIGHUP {error 0}}}
  241.  
  242.     Test signal-1.18 {signal tests} {
  243.         signal block SIGHUP
  244.         signal error SIGHUP
  245.         signal get SIGHUP
  246.     } 0 {{SIGHUP {error 1}}}
  247.  
  248.     signal unblock SIGHUP
  249.     signal default SIGHUP
  250. }
  251.  
  252.  
  253. Test signal-2.1 {kill tests} {
  254.     kill
  255. } 1 {wrong # args: kill ?signal? processlist}
  256.  
  257. signal error SIGINT
  258.  
  259. Test signal-2.2 {kill tests} {
  260.     kill 2 [id process]
  261. } 1 {SIGINT signal received}
  262.  
  263. Test signal-2.3 {kill tests} {
  264.     kill INT [id process]
  265. } 1 {SIGINT signal received}
  266.  
  267. Test signal-2.4 {kill tests} {
  268.     kill SIGINT [id process]
  269. } 1 {SIGINT signal received}
  270.  
  271. Test signal-2.5 {kill tests} {
  272.     kill 10000 [id process]
  273. } 1 {invalid signal}
  274.  
  275. Test signal-2.6 {kill tests} {
  276.     kill SIGFOO [id process]
  277. } 1 {invalid signal}
  278.  
  279. Test signal-2.7 {kill tests} {
  280.     kill 0 [id process]
  281. } 0 {}
  282.